;;;Place a custom linetype as an anonymous block. It allows linear as well as curved sections. (uses UPOINT UREAL)
;;;       The user toggles
;;;       between the two during placement.  The block entity is not placed in
;;;       the drawing until the user terminates the input with a return
;;;       supplied to the "next point" prompt.  Size of the graphic elements
;;;       is determined by the dimscale.  If the user matches the dimscale
;;;       with the drawing scale the graphics will scale the same on all
;;;       drawings.  The linetype consists of equally spaced X's (nearest
;;;       to 1/2" spacing at scale for the length of arc or line) and lines
;;;       between them that do not touch.  If the variable modf = "EXST" the
;;;       circle radius is 0.0625125 x dimscale, if not it is 0.0469 x dimscale.
;;;
;;;	AUTHOR: HENRY C. FRANCIS
;;;		425 N. ASHE ST.
;;;		SOUTHERN PINES, NC 28387
;;;              
;;;		All rights reserved without prejudice.
;;;
;;;	Copyright:	6-7-95
;;;	Edited:		7-29-2005
;;;
(defun c:textline ( / arcb fensta clspt fpt chrdl strtl clclf count fpt1 fpt2 arcs arcc fltot)
(setq osmod (getvar"osmode")
      fltot 0)
(setvar "osmode" 0)
(entmake (list (cons 0 "endblk")))
  (if dimscl nil (load"dimscl" "\nFile DIMSCL.LSP not loaded! "))
  (dimscl)
  (setq aorln " Arc/<Line first point>")
  (cond
    ((eq modf "EXST")
      (setq cirad (* dimsc 0.044))
      (setq fensta "Existing"))
    ((not(eq modf "EXST"))
      (setq cirad (* dimsc 0.066))
      (setq fensta "Proposed"))
  );cond
  (entmake
    (list
      (cons 0 "BLOCK")
      (cons 70 1)
      (cons 2 "*U")
      (cons 10 (list 0 0 0))
    )
  )
  (if upoint nil (load"upoint" "\nFile UPOINT.LSP not loaded! "))
  (if ureal nil (load"ureal" "\nFile UREAL.LSP not loaded! "))
  (if ustr nil (load"ustr" "\nFile USTR.LSP not loaded! "))
  (SETQ txtchar (ustr 1 "Text to embed in linetype:" (IF txtchar txtchar "X") T))
  (while(not fpt1)
    (setq fpt (upoint 0 "Arc Line" (strcat fensta " fence" aorln) nil nil))
    (cond
      ((eq fpt "Arc")
        (setq aorln " Line/<Arc first point>"))
      ((eq fpt "Line")
        (setq aorln " Arc/<Line first point>"))
      (fpt
        (setq fpt1 fpt
              clspt fpt1
              strtl 1
	      first_pt fpt))
    );cond
  );while
  (while
    (and
      (not clclf)
      (if(eq fpt "Arc")
        (setq fpt2 (upoint 0 "Close" (strcat fensta " fence Close/<Arc next point>") nil fpt1))
        (if(or(not fpt2)(< strtl 3))
          (progn
            (setq strtl (1+ strtl))
            (setq fpt2 (upoint 0 "Arc" (strcat fensta " fence Arc/<Line next point>") nil fpt1))
          );progn
          (setq fpt2 (upoint 0 "Arc Close" (strcat fensta " fence Arc/Close/<Line next point>") nil fpt1))
        );if
      );if
    );and
    (if(eq fpt2 "Close")
      (setq fpt2 clspt
            clclf T)
    );if
    (if
      (or
        (eq fpt2 "Arc")
        (eq fpt "Arc")
      );or
      (progn
        (cond
          ((eq fpt "Arc")
            (setq chrdl (distance fpt1 fpt2))
            (bulge))
        );cond
        (if(eq fpt2 "Arc")
          (progn
            (if clclf
              nil
              (setq fpt2 (upoint 0 "Close" (strcat fensta " fence Close/<Arc next point>") nil fpt1))
            );if
            (if(eq fpt2 "Close")
              (setq fpt2 clspt
                    clclf T)
            );if
            (setq chrdl (distance fpt1 fpt2))
            (bulge)
            (while (>= chrdl (* arcr 2))
              (progn
                (princ (strcat"\nChord length greater than or equal to 2r <" (rtos(/ chrdl 2))" min.>"))
                (setq arcr nil)
                (bulge)
              );progn
            );while
            (setq fpt "Arc")
          );progn
        );if
        (if(eq fpt2 "Close")
          (setq fpt2 clspt
                clclf T)
        );if
        (setq chrdl (distance fpt1 fpt2))
        (bulge)
        (while (>= chrdl (* arcr 2))
          (progn
            (princ (strcat"\nChord length greater than or equal to 2r <" (rtos(/ chrdl 2))" min.>"))
            (setq arcl nil)
            (bulge)
          );progn
        );while
        (progn
          (setq incla(*(atan(/ chrdl(* 2 arcr))(sqrt(- 1(*(/ chrdl(* 2 arcr))(/ chrdl(* 2 arcr))))))2)
                oangs (/(- pi incla)2)
                langl (angle fpt1 fpt2)
                lpt (polar fpt1 (+ langl oangs) arcr)
                rpt (polar fpt1 (- langl oangs) arcr)
          );setq
          (if
            (or
              (and
                (<(distance lpt arcc)(distance rpt arcc))
                (<(distance lpt arcs)(distance rpt arcs))
              );and
              (and
                (>(distance lpt arcc)(distance rpt arcc))
                (>(distance lpt arcs)(distance rpt arcs))
              );and
            );or
            (setq incla (-(+ pi pi)incla))
          );if
          (setq fenl (* incla arcr)
                count (1+(fix(/ fenl (* dimsc 0.5))))
                incrn (1- count)
          );setq
          (while
            (> count 0)
            (if(<(distance lpt arcc)(distance rpt arcc))
              (if(<(distance lpt arcs)(distance rpt arcs))
                (setq ipt lpt
                      incra (+(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                      langl (angle fpt1 fpt4)
                );setq
                (setq ipt lpt
                      incra (-(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                      langl (angle fpt1 fpt4)
                );setq
              );if
              (if(>(distance lpt arcs)(distance rpt arcs))
                (setq ipt rpt
                      incra (-(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                      langl (angle fpt1 fpt4)
                );setq
                (setq ipt rpt
                      incra (+(angle ipt fpt2)(*(/ incla incrn)(1- count)))
                      fpt4 (polar ipt incra arcr)
                      fpt3 (polar fpt1 (angle fpt1 fpt4)(* dimsc 0.0625))
                      fpt5 (polar fpt4 (+(angle fpt1 fpt4)pi) (* dimsc 0.0625))
                      langl (angle fpt1 fpt4)
                );setq
              );if
            );if
            (setq lang2 (+ langl (* pi 0.25))
                  lang3 (+ langl (* pi 0.75))
                  fpt7 (polar fpt1 langl (* dimsc 0.0625))
                  fpt8 (polar fpt1 langl cispc)
                  fpt9 (polar fpt4 (+ langl pi) (* dimsc 0.0625))
                  fpt10 (polar fpt4 lang2 cirad)
                  fpt11 (polar fpt4 (+ pi lang2) cirad)
                  fpt12 (polar fpt4 lang3 cirad)
                  fpt13 (polar fpt4 (+ pi lang3) cirad)
                  fpt14 (polar fpt1 lang2 cirad)
                  fpt15 (polar fpt1 (+ pi lang2) cirad)
                  fpt16 (polar fpt1 lang3 cirad)
                  fpt17 (polar fpt1 (+ pi lang3) cirad)
            );setq
            (if(eq(1- count)incrn)
              nil
              (progn
                (entmake
                  (list
                    (cons 0 "LINE")
                    (cons 10 fpt3)
                    (cons 11 fpt5)
                    (cons 8 "0")
                  )
                )
                (grdraw fpt3 fpt5 7)
		(entmake
		  (list
		    (cons 0 "text")
		    (cons 1 (IF txtchar txtchar "X"))
                    (cons 8 "0")
		    (cons 10 fpt4)
		    (cons 11 fpt4)
		    (cons 40 (getvar "textsize"))
		    (cons 50 langl)
		    (cons 71 0)
		    (cons 72 1)
		    (cons 73 2)
		  )
		)
;;;            (entmake
;;;              (list
;;;                (cons 0 "LINE")
;;;                (cons 10 fpt10)
;;;                (cons 11 fpt11)
;;;                (cons 8 "0")
;;;              )
;;;            )
;;;            (entmake
;;;              (list
;;;                (cons 0 "LINE")
;;;                (cons 10 fpt12)
;;;                (cons 11 fpt13)
;;;                (cons 8 "0")
;;;              )
;;;            )
              );progn
            );if
            (setq fpt1 fpt4
                  count (1- count)
            );setq
            (setq fpt nil)
          );while
        );progn
      );progn
      (progn
      (setq fenl (distance fpt1 fpt2)
            count (1+(fix(/ fenl (* dimsc 0.5))))
            cispc (/ fenl count)
      );setq
      (IF (> strtl 2)
	NIL
	(SETQ second_pt fpt2)
      )
      (while
        (> count 0)
        (setq langl (angle fpt1 fpt2)
              lang2 (+ langl (* pi 0.25))
              lang3 (+ langl (* pi 0.75))
              fpt3 (polar fpt1 (angle fpt1 fpt2)(* dimsc 0.0625))
              fpt4 (polar fpt1 langl cispc)
              fpt5 (polar fpt4 (+(angle fpt1 fpt2)pi) (* dimsc 0.0625))
              fpt7 (polar fpt1 langl (* dimsc 0.0625))
              fpt8 (polar fpt1 langl cispc)
              fpt9 (polar fpt4 (+ langl pi) (* dimsc 0.0625))
              fpt10 (polar fpt4 lang2 cirad)
              fpt11 (polar fpt4 (+ pi lang2) cirad)
              fpt12 (polar fpt4 lang3 cirad)
              fpt13 (polar fpt4 (+ pi lang3) cirad)
              fpt14 (polar fpt1 lang2 cirad)
              fpt15 (polar fpt1 (+ pi lang2) cirad)
              fpt16 (polar fpt1 lang3 cirad)
              fpt17 (polar fpt1 (+ pi lang3) cirad)
        );setq
        (entmake
          (list
            (cons 0 "LINE")
            (cons 10 fpt3)
            (cons 11 fpt5)
            (cons 8 "0")
          )
        )
        (grdraw fpt3 fpt5 7)
		(entmake
		  (list
		    (cons 0 "text")
		    (cons 1 (IF txtchar txtchar "X"))
                    (cons 8 "0")
		    (cons 10 fpt4)
		    (cons 11 fpt4)
		    (cons 40 (getvar "textsize"))
		    (cons 50 langl)
		    (cons 71 0)
		    (cons 72 1)
		    (cons 73 2)
		  )
		)
;;;            (entmake
;;;              (list
;;;                (cons 0 "LINE")
;;;                (cons 10 fpt7)
;;;                (cons 11 fpt9)
;;;                (cons 8 "0")
;;;              )
;;;            )
;;;            (entmake
;;;              (list
;;;                (cons 0 "LINE")
;;;                (cons 10 fpt10)
;;;                (cons 11 fpt11)
;;;                (cons 8 "0")
;;;              )
;;;            )
;;;            (entmake
;;;              (list
;;;                (cons 0 "LINE")
;;;                (cons 10 fpt12)
;;;                (cons 11 fpt13)
;;;                (cons 8 "0")
;;;              )
;;;            )
        (setq fpt1 fpt4
              count (1- count)
        );setq
      );while
      );progn
    );if
    (setq arcc nil arcs nil arcm nil)
    (setq fltot (+ fltot fenl))
  );while
  (setq langl (angle first_pt second_pt)
        lang2 (+ langl (* pi 0.25))
        lang3 (+ langl (* pi 0.75))
        spt10 (polar first_pt lang2 cirad)
        spt11 (polar first_pt (+ pi lang2) cirad)
        spt12 (polar first_pt lang3 cirad)
        spt13 (polar first_pt (+ pi lang3) cirad)
  )
;;;  (entmake
;;;    (list
;;;      (cons 0 "LINE")
;;;      (cons 10 spt10)
;;;      (cons 11 spt11)
;;;      (cons 8 "0")
;;;    )
;;;  )
;;;  (entmake
;;;    (list
;;;      (cons 0 "LINE")
;;;      (cons 10 spt12)
;;;      (cons 11 spt13)
;;;      (cons 8 "0")
;;;    )
;;;  )
;;;  (entmake
;;;    (list
;;;      (cons 0 "ATTDEF")
;;;      (cons 10 clspt)
;;;      (cons 40 (* 0.110 dimsc))
;;;      (cons 1 (rtos fltot))
;;;      (cons 3 (strcat(rtos fltot)" LF Fence: "))
;;;      (cons 2 (strcat(rtos fltot)"_LF_FENCE:"))
;;;      (cons 70 1)
;;;    );list
;;;  );entmake
(setq nblk (entmake (list (cons 0 "endblk"))))
(princ (strcat "\nBlock "(if nblk nblk "NOT")" Made\n"))
(princ (strcat "\n"(rtos fltot)" LF of fence added "))
  (entmake
    (list
      (cons 0 "INSERT")
      (cons 2 nblk)
      (cons 10 (list 0 0 0))
      (cons 8 (getvar"clayer"))
      (cons 70 1)
      (cons 66 1)
    )
  )
;;;  (entmake
;;;    (list
;;;      (cons 0 "ATTRIB")
;;;      (cons 10 clspt)
;;;      (cons 40 (* 0.110 dimsc))
;;;      (cons 1 (rtos fltot))
;;;      (cons 2 (strcat(rtos fltot)"_LF_FENCE:"))
;;;      (cons 70 1)
;;;    );list
;;;  );entmake
  (entmake
    (list
      (cons 0 "SEQEND")
    );list
  );entmake
(setvar "osmode" osmod)
(setq arcb nil)
(princ)
);defun
;********
(defun bulge ( / )
  (if(eq arcm "Bulge")
    (progn
    (if(and fpt2 chrdl arcs)
      nil
      (progn
        (setq arcb (ureal 1 "Radius" "Arc Radius/<Bulge>" (if arcb arcb nil)))
        (if(eq arcb "Radius")
          (progn
            (setq arcm nil arcb nil)
            (bulge)
          );progn
          (progn
            (cond
              ((not fpt2)
                (setq fpt2 (upoint 0 "Close" (strcat fensta " fence Close/<Arc next point>") nil fpt1))
                (if(eq fpt2 "Close")
                  (setq fpt2 clspt
                        clclf T)
                ));if ;not
            );cond
            (setq chrdl (distance fpt1 fpt2))
            (setq arcr
              (/
                (* chrdl(sin(-(atan(/ chrdl 2)arcb)(atan(/ arcb(/ chrdl 2))))))
                (sin(* 2(- pi(* 2(atan(/ chrdl 2)arcb)))))
              )
            );setq
            (setq arcs (upoint 1 "" "Pick side for arc" nil nil))
            (if
              (<(distance lpt arcs)(distance rpt arcs))
                (setq arcc rpt)
                (setq arcc lpt)
            );if
          );progn
        );if
      );progn
    );if
    );progn
    (if(or(not arcc)(not arcs)(not arcr))
      (progn
        (setq arcm (ureal 1 "Bulge" "Arc Bulge/<Radius>" (if arcr arcr nil)))
        (if(eq arcm "Bulge")
          (bulge)
          (progn
            (setq arcr arcm arcm nil)
            (setq arcc (upoint 1 "" "Pick side for arc center" nil nil))
            (setq arcs (upoint 1 "" "Pick side for arc" nil nil))
          );progn
        );if
      );progn
    );if
  );if
  (princ)
);defun
